home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 11 / CU Amiga Magazine's Super CD-ROM 11 (1997)(EMAP Images)(GB)(Track 1 of 3)[!][issue 1997-06].iso / cucd / programming / oberonv4 / source / system / opp.mod (.txt) < prev    next >
Oberon Text  |  1996-05-10  |  35KB  |  1,013 lines
  1. Syntax24.Scn.Fnt
  2. Syntax10b.Scn.Fnt
  3. Syntax10.Scn.Fnt
  4. Syntax10i.Scn.Fnt
  5. (* Notify Ralf for maintenance of Non-FPU source *)
  6. MODULE OPP;    (* NW, RC 6.3.89 / 10.2.94 *)
  7.     IMPORT
  8.         OPT, OPS, OPM, OPB;
  9.     CONST
  10.         (* numtyp values *)
  11.         char = 1; integer = 2; real = 3; longreal = 4;
  12.         (* symbol values *)
  13.         null = 0; times = 1; slash = 2; div = 3; mod = 4;
  14.         and = 5; plus = 6; minus = 7; or = 8; eql = 9;
  15.         neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
  16.         in = 15; is = 16; arrow = 17; period = 18; comma = 19;
  17.         colon = 20; upto = 21; rparen = 22; rbrak = 23; rbrace = 24;
  18.         of = 25; then = 26; do = 27; to = 28; by = 29;
  19.         lparen = 30; lbrak = 31; lbrace = 32; not = 33; becomes = 34;
  20.         number = 35; nil = 36; string = 37; ident = 38; semicolon = 39;
  21.         bar = 40; end = 41; else = 42; elsif = 43; until = 44;
  22.         if = 45; case = 46; while = 47; repeat = 48; for = 49;
  23.         loop = 50; with = 51; exit = 52; return = 53; array = 54;
  24.         record = 55; pointer = 56; begin = 57; const = 58; type = 59;
  25.         var = 60; procedure = 61; import = 62; module = 63; eof = 64;
  26.         (* object modes *)
  27.         Var = 1; VarPar = 2; Con = 3; Fld = 4; Typ = 5; LProc = 6; XProc = 7;
  28.         SProc = 8; CProc = 9; IProc = 10; Mod = 11; Head = 12; TProc = 13;
  29.         (* Structure forms *)
  30.         Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
  31.         Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
  32.         Pointer = 13; ProcTyp = 14; Comp = 15;
  33.         intSet = {SInt..LInt};
  34.         (* composite structure forms *)
  35.         Basic = 1; Array = 2; DynArr = 3; Record = 4;
  36.         (*function number*)
  37.         haltfn = 0; newfn = 1; incfn = 13; sysnewfn = 30;
  38.         (* nodes classes *)
  39.         Nvar = 0; Nvarpar = 1; Nfield = 2; Nderef = 3; Nindex = 4; Nguard = 5; Neguard = 6;
  40.         Nconst = 7; Ntype = 8; Nproc = 9; Nupto = 10; Nmop = 11; Ndop = 12; Ncall = 13;
  41.         Ninittd = 14; Nif = 15; Ncaselse = 16; Ncasedo = 17; Nenter = 18; Nassign = 19;
  42.         Nifelse = 20; Ncase = 21; Nwhile = 22; Nrepeat = 23; Nloop = 24; Nexit = 25;
  43.         Nreturn = 26; Nwith = 27; Ntrap = 28;
  44.         (* node subclasses *)
  45.         super = 1;
  46.         (* module visibility of objects *)
  47.         internal = 0; external = 1; externalR = 2;
  48.         (* procedure flags (conval^.setval) *)
  49.         hasBody = 1; isRedef = 2; slNeeded = 3;
  50.     TYPE
  51.         CaseTable = ARRAY OPM.MaxCases OF
  52.             RECORD
  53.                 low, high: LONGINT
  54.             END ;
  55.         sym, level: SHORTINT;
  56.         LoopLevel: INTEGER;
  57.         TDinit, lastTDinit: OPT.Node;
  58.         nofFwdPtr: INTEGER;
  59.         FwdPtr: ARRAY 64 OF OPT.Struct;
  60.     PROCEDURE^ Type(VAR typ, banned: OPT.Struct);
  61.     PROCEDURE^ Expression(VAR x: OPT.Node);
  62.     PROCEDURE^ Block(VAR procdec, statseq: OPT.Node);
  63.     PROCEDURE err(n: INTEGER);
  64.     BEGIN OPM.err(n)
  65.     END err;
  66.     PROCEDURE CheckSym(s: INTEGER);
  67.     BEGIN
  68.         IF sym = s THEN OPS.Get(sym) ELSE OPM.err(s) END
  69.     END CheckSym;
  70.     PROCEDURE qualident(VAR id: OPT.Object);
  71.         VAR obj: OPT.Object; lev: SHORTINT;
  72.     BEGIN (*sym = ident*)
  73.         OPT.Find(obj); OPS.Get(sym);
  74.         IF (sym = period) & (obj # NIL) & (obj^.mode = Mod) THEN
  75.             OPS.Get(sym);
  76.             IF sym = ident THEN
  77.                 OPT.FindImport(obj, obj); OPS.Get(sym)
  78.             ELSE err(ident); obj := NIL
  79.             END
  80.         END ;
  81.         IF obj = NIL THEN err(0);
  82.             obj := OPT.NewObj(); obj^.mode := Var; obj^.typ := OPT.undftyp; obj^.adr := 0
  83.         ELSE lev := obj^.mnolev;
  84.             IF (obj^.mode IN {Var, VarPar}) & (lev # level) THEN
  85.                 obj^.leaf := FALSE;
  86.                 IF lev > 0 THEN OPB.StaticLink(level-lev) END
  87.             END
  88.         END ;
  89.         id := obj
  90.     END qualident;
  91.     PROCEDURE ConstExpression(VAR x: OPT.Node);
  92.     BEGIN Expression(x);
  93.         IF x^.class # Nconst THEN
  94.             err(50); x := OPB.NewIntConst(1) 
  95.         END
  96.     END ConstExpression;
  97.     PROCEDURE CheckMark(VAR vis: SHORTINT);
  98.     BEGIN OPS.Get(sym);
  99.         IF (sym = times) OR (sym = minus) THEN
  100.             IF level > 0 THEN err(47) END ;
  101.             IF sym = times THEN vis := external ELSE vis := externalR END ;
  102.             OPS.Get(sym)
  103.         ELSE vis := internal
  104.         END
  105.     END CheckMark;
  106.     PROCEDURE CheckSysFlag(VAR sysflag: INTEGER; default: INTEGER);
  107.         VAR x: OPT.Node; sf: LONGINT;
  108.     BEGIN
  109.         IF sym = lbrak THEN OPS.Get(sym); ConstExpression(x);
  110.             IF x^.typ^.form IN intSet THEN sf := x^.conval^.intval;
  111.                 IF (sf < 0) OR (sf > OPM.MaxSysFlag) THEN err(220); sf := 0 END
  112.             ELSE err(51); sf := 0
  113.             END ;
  114.             sysflag := SHORT(sf); CheckSym(rbrak)
  115.         ELSE sysflag := default
  116.         END
  117.     END CheckSysFlag;
  118.     PROCEDURE RecordType(VAR typ, banned: OPT.Struct);
  119.         VAR fld, first, last, base: OPT.Object;
  120.             ftyp: OPT.Struct; sysflag: INTEGER;
  121.     BEGIN typ := OPT.NewStr(Comp, Record); typ^.BaseTyp := NIL;
  122.         CheckSysFlag(sysflag, -1);
  123.         IF sym = lparen THEN
  124.             OPS.Get(sym); (*record extension*)
  125.             IF sym = ident THEN
  126.                 qualident(base);
  127.                 IF (base^.mode = Typ) & (base^.typ^.comp = Record) THEN
  128.                     IF base^.typ = banned THEN err(58)
  129.                     ELSE typ^.BaseTyp := base^.typ; typ^.extlev := base^.typ^.extlev + 1; typ^.sysflag := base^.typ^.sysflag
  130.                     END
  131.                 ELSE err(52)
  132.                 END
  133.             ELSE err(ident)
  134.             END ;
  135.             CheckSym(rparen)
  136.         END ;
  137.         IF sysflag >= 0 THEN typ^.sysflag := sysflag END ;
  138.         OPT.OpenScope(0, NIL); first := NIL; last := NIL;
  139.         LOOP
  140.             IF sym = ident THEN
  141.                 LOOP
  142.                     IF sym = ident THEN
  143.                         IF typ^.BaseTyp # NIL THEN
  144.                             OPT.FindField(OPS.name, typ^.BaseTyp, fld);
  145.                             IF fld # NIL THEN err(1) END
  146.                         END ;
  147.                         OPT.Insert(OPS.name, fld); CheckMark(fld^.vis);
  148.                         fld^.mode := Fld; fld^.link := NIL; fld^.typ := OPT.undftyp;
  149.                         IF first = NIL THEN first := fld END ;
  150.                         IF last = NIL THEN typ^.link := fld ELSE last^.link := fld END ;
  151.                         last := fld
  152.                     ELSE err(ident)
  153.                     END ;
  154.                     IF sym = comma THEN OPS.Get(sym)
  155.                     ELSIF sym = ident THEN err(comma)
  156.                     ELSE EXIT
  157.                     END
  158.                 END ;
  159.                 CheckSym(colon); Type(ftyp, banned);
  160.                 IF ftyp^.comp = DynArr THEN ftyp := OPT.undftyp; err(88) END ;
  161.                 WHILE first # NIL DO
  162.                     first^.typ := ftyp; first := first^.link
  163.                 END
  164.             END ;
  165.             IF sym = semicolon THEN OPS.Get(sym)
  166.             ELSIF sym = ident THEN err(semicolon)
  167.             ELSE EXIT
  168.             END
  169.         END ;
  170.         OPT.CloseScope
  171.     END RecordType;
  172.     PROCEDURE ArrayType(VAR typ, banned: OPT.Struct);
  173.         VAR x: OPT.Node; n: LONGINT; sysflag: INTEGER;
  174.     BEGIN CheckSysFlag(sysflag, 0);
  175.         IF sym = of THEN    (*dynamic array*)
  176.             typ := OPT.NewStr(Comp, DynArr); typ^.mno := 0; typ^.sysflag := sysflag;
  177.             OPS.Get(sym); Type(typ^.BaseTyp, banned);
  178.             IF typ^.BaseTyp^.comp = DynArr THEN typ^.n := typ^.BaseTyp^.n + 1
  179.             ELSE typ^.n := 0
  180.             END
  181.         ELSE
  182.             typ := OPT.NewStr(Comp, Array); typ^.sysflag := sysflag; ConstExpression(x);
  183.             IF x^.typ^.form IN intSet THEN n := x^.conval^.intval;
  184.                 IF (n <= 0) OR (n > OPM.MaxIndex) THEN err(63); n := 1 END
  185.             ELSE err(51); n := 1
  186.             END ;
  187.             typ^.n := n;
  188.             IF sym = of THEN
  189.                 OPS.Get(sym); Type(typ^.BaseTyp, banned)
  190.             ELSIF sym = comma THEN
  191.                 OPS.Get(sym); IF sym # of THEN ArrayType(typ^.BaseTyp, banned) END
  192.             ELSE err(35)
  193.             END ;
  194.             IF typ^.BaseTyp^.comp = DynArr THEN typ^.BaseTyp := OPT.undftyp; err(88) END
  195.         END
  196.     END ArrayType;
  197.     PROCEDURE PointerType(VAR typ: OPT.Struct);
  198.         VAR id: OPT.Object;
  199.     BEGIN typ := OPT.NewStr(Pointer, Basic); CheckSysFlag(typ^.sysflag, 0);
  200.         CheckSym(to);
  201.         IF sym = ident THEN OPT.Find(id);
  202.             IF id = NIL THEN
  203.                 IF nofFwdPtr < LEN(FwdPtr) THEN FwdPtr[nofFwdPtr] := typ; INC(nofFwdPtr)
  204.                 ELSE err(224)
  205.                 END ;
  206.                 typ^.link := OPT.NewObj(); COPY(OPS.name, typ^.link^.name);
  207.                 typ^.BaseTyp := OPT.undftyp; OPS.Get(sym) (*forward ref*)
  208.             ELSE qualident(id);
  209.                 IF id^.mode = Typ THEN
  210.                     IF id^.typ^.comp IN {Array, DynArr, Record} THEN
  211.                         typ^.BaseTyp := id^.typ
  212.                     ELSE typ^.BaseTyp := OPT.undftyp; err(57)
  213.                     END
  214.                 ELSE typ^.BaseTyp := OPT.undftyp; err(52)
  215.                 END
  216.             END
  217.         ELSE Type(typ^.BaseTyp, OPT.notyp);
  218.             IF ~(typ^.BaseTyp^.comp IN {Array, DynArr, Record}) THEN
  219.                 typ^.BaseTyp := OPT.undftyp; err(57)
  220.             END
  221.         END
  222.     END PointerType;
  223.     PROCEDURE FormalParameters(VAR firstPar: OPT.Object; VAR resTyp: OPT.Struct);
  224.         VAR mode: SHORTINT;
  225.                 par, first, last, res: OPT.Object; typ: OPT.Struct;
  226.     BEGIN first := NIL; last := firstPar;
  227.         IF (sym = ident) OR (sym = var) THEN
  228.             LOOP
  229.                 IF sym = var THEN OPS.Get(sym); mode := VarPar ELSE mode := Var END ;
  230.                 LOOP
  231.                     IF sym = ident THEN
  232.                         OPT.Insert(OPS.name, par); OPS.Get(sym);
  233.                         par^.mode := mode; par^.link := NIL;
  234.                         IF first = NIL THEN first := par END ;
  235.                         IF firstPar = NIL THEN firstPar := par ELSE last^.link := par END ;
  236.                         last := par
  237.                     ELSE err(ident)
  238.                     END ;
  239.                     IF sym = comma THEN OPS.Get(sym)
  240.                     ELSIF sym = ident THEN err(comma)
  241.                     ELSIF sym = var THEN err(comma); OPS.Get(sym)
  242.                     ELSE EXIT
  243.                     END
  244.                 END ;
  245.                 CheckSym(colon); Type(typ, OPT.notyp);
  246.                 WHILE first # NIL DO first^.typ := typ; first := first^.link END ;
  247.                 IF sym = semicolon THEN OPS.Get(sym)
  248.                 ELSIF sym = ident THEN err(semicolon)
  249.                 ELSE EXIT
  250.                 END
  251.             END
  252.         END ;
  253.         CheckSym(rparen);
  254.         IF sym = colon THEN
  255.             OPS.Get(sym); resTyp := OPT.undftyp;
  256.             IF sym = ident THEN qualident(res);
  257.                 IF res^.mode = Typ THEN
  258.                     IF res^.typ^.form < Comp THEN resTyp := res^.typ
  259.                     ELSE err(54)
  260.                     END
  261.                 ELSE err(52)
  262.                 END
  263.             ELSE err(ident)
  264.             END
  265.         ELSE resTyp := OPT.notyp
  266.         END
  267.     END FormalParameters;
  268.     PROCEDURE TypeDecl(VAR typ, banned: OPT.Struct);
  269.         VAR id: OPT.Object;
  270.     BEGIN typ := OPT.undftyp;
  271.         IF sym < lparen THEN err(12);
  272.             REPEAT OPS.Get(sym) UNTIL sym >= lparen
  273.         END ;
  274.         IF sym = ident THEN qualident(id);
  275.             IF id^.mode = Typ THEN
  276.                 IF id^.typ # banned THEN typ := id^.typ ELSE err(58) END
  277.             ELSE err(52)
  278.             END
  279.         ELSIF sym = array THEN
  280.             OPS.Get(sym); ArrayType(typ, banned)
  281.         ELSIF sym = record THEN
  282.             OPS.Get(sym); RecordType(typ, banned);
  283.             OPB.Inittd(TDinit, lastTDinit, typ); CheckSym(end)
  284.         ELSIF sym = pointer THEN
  285.             OPS.Get(sym); PointerType(typ)
  286.         ELSIF sym = procedure THEN
  287.             OPS.Get(sym); typ := OPT.NewStr(ProcTyp, Basic); CheckSysFlag(typ^.sysflag, 0);
  288.             IF sym = lparen THEN
  289.                 OPS.Get(sym); OPT.OpenScope(level, NIL);
  290.                 FormalParameters(typ^.link, typ^.BaseTyp); OPT.CloseScope
  291.             ELSE typ^.BaseTyp := OPT.notyp; typ^.link := NIL
  292.             END
  293.         ELSE err(12)
  294.         END ;
  295.         LOOP
  296.             IF (sym >= semicolon) & (sym <= else) OR (sym = rparen) OR (sym = eof) THEN EXIT END;
  297.             err(15); IF sym = ident THEN EXIT END;
  298.             OPS.Get(sym)
  299.         END
  300.     END TypeDecl;
  301.     PROCEDURE Type(VAR typ, banned: OPT.Struct);
  302.     BEGIN TypeDecl(typ, banned);
  303.         IF (typ^.form = Pointer) & (typ^.BaseTyp = OPT.undftyp) & (typ^.strobj = NIL) THEN err(0) END
  304.     END Type;
  305.     PROCEDURE selector(VAR x: OPT.Node);
  306.         VAR obj, proc: OPT.Object; y: OPT.Node; typ: OPT.Struct; name: OPS.Name;
  307.     BEGIN
  308.         LOOP
  309.             IF sym = lbrak THEN OPS.Get(sym);
  310.                 LOOP
  311.                     IF (x^.typ # NIL) & (x^.typ^.form = Pointer) THEN OPB.DeRef(x) END ;
  312.                     Expression(y); OPB.Index(x, y);
  313.                     IF sym = comma THEN OPS.Get(sym) ELSE EXIT END
  314.                 END ;
  315.                 CheckSym(rbrak)
  316.             ELSIF sym = period THEN OPS.Get(sym);
  317.                 IF sym = ident THEN name := OPS.name; OPS.Get(sym);
  318.                     IF x^.typ # NIL THEN
  319.                         IF x^.typ^.form = Pointer THEN OPB.DeRef(x) END ;
  320.                         IF x^.typ^.comp = Record THEN
  321.                             OPT.FindField(name, x^.typ, obj); OPB.Field(x, obj);
  322.                             IF (obj # NIL) & (obj^.mode = TProc) THEN
  323.                                 IF sym = arrow THEN  (* super call *) OPS.Get(sym);
  324.                                     y := x^.left;
  325.                                     IF y^.class = Nderef THEN y := y^.left END ;    (* y = record variable *)
  326.                                     IF y^.obj # NIL THEN
  327.                                         proc := OPT.topScope;    (* find innermost scope which owner is a TProc *)
  328.                                         WHILE (proc^.link # NIL) & (proc^.link^.mode # TProc) DO proc := proc^.left END ;
  329.                                         IF (proc^.link = NIL) OR (proc^.link^.link # y^.obj) THEN err(75) END ;
  330.                                         typ := y^.obj^.typ;
  331.                                         IF typ^.form = Pointer THEN typ := typ^.BaseTyp END ;
  332.                                         OPT.FindField(x^.obj^.name, typ^.BaseTyp, proc);
  333.                                         IF proc # NIL THEN x^.subcl := super ELSE err(74) END
  334.                                     ELSE err(75)
  335.                                     END
  336.                                 END ;
  337.                                 IF (obj^.typ # OPT.notyp) & (sym # lparen) THEN err(lparen) END
  338.                             END
  339.                         ELSE err(53)
  340.                         END
  341.                     ELSE err(52)
  342.                     END
  343.                 ELSE err(ident)
  344.                 END
  345.             ELSIF sym = arrow THEN OPS.Get(sym); OPB.DeRef(x)
  346.             ELSIF (sym = lparen) & (x^.class < Nconst) & (x^.typ^.form # ProcTyp) &
  347.                     ((x^.obj = NIL) OR (x^.obj^.mode # TProc)) THEN
  348.                 OPS.Get(sym);
  349.                 IF sym = ident THEN
  350.                     qualident(obj);
  351.                     IF obj^.mode = Typ THEN OPB.TypTest(x, obj, TRUE)
  352.                     ELSE err(52)
  353.                     END
  354.                 ELSE err(ident)
  355.                 END ;
  356.                 CheckSym(rparen)
  357.             ELSE EXIT
  358.             END
  359.         END
  360.     END selector;
  361.     PROCEDURE ActualParameters(VAR aparlist: OPT.Node; fpar: OPT.Object);
  362.         VAR apar, last: OPT.Node;
  363.     BEGIN aparlist := NIL; last := NIL;
  364.         IF sym # rparen THEN
  365.             LOOP Expression(apar);
  366.                 IF fpar # NIL THEN
  367.                     OPB.Param(apar, fpar); OPB.Link(aparlist, last, apar);
  368.                     fpar := fpar^.link;
  369.                 ELSE err(64)
  370.                 END ;
  371.                 IF sym = comma THEN OPS.Get(sym)
  372.                 ELSIF (lparen <= sym) & (sym <= ident) THEN err(comma)
  373.                 ELSE EXIT
  374.                 END
  375.             END
  376.         END ;
  377.         IF fpar # NIL THEN err(65) END
  378.     END ActualParameters;
  379.     PROCEDURE StandProcCall(VAR x: OPT.Node);
  380.         VAR y: OPT.Node; m: SHORTINT; n: INTEGER;
  381.     BEGIN m := SHORT(SHORT(x^.obj^.adr)); n := 0;
  382.         IF sym = lparen THEN OPS.Get(sym);
  383.             IF sym # rparen THEN
  384.                 LOOP
  385.                     IF n = 0 THEN Expression(x); OPB.StPar0(x, m); n := 1
  386.                     ELSIF n = 1 THEN Expression(y); OPB.StPar1(x, y, m); n := 2
  387.                     ELSE Expression(y); OPB.StParN(x, y, m, n); INC(n)
  388.                     END ;
  389.                     IF sym = comma THEN OPS.Get(sym)
  390.                     ELSIF (lparen <= sym) & (sym <= ident) THEN err(comma)
  391.                     ELSE EXIT
  392.                     END
  393.                 END ;
  394.                 CheckSym(rparen)
  395.             ELSE OPS.Get(sym)
  396.             END ;
  397.             OPB.StFct(x, m, n)
  398.         ELSE err(lparen)
  399.         END ;
  400.         IF (level > 0) & ((m = newfn) OR (m = sysnewfn)) THEN OPT.topScope^.link^.leaf := FALSE END
  401.     END StandProcCall;
  402.     PROCEDURE Element(VAR x: OPT.Node);
  403.         VAR y: OPT.Node;
  404.     BEGIN Expression(x);
  405.         IF sym = upto THEN
  406.             OPS.Get(sym); Expression(y); OPB.SetRange(x, y)
  407.         ELSE OPB.SetElem(x)
  408.         END
  409.     END Element;
  410.     PROCEDURE Sets(VAR x: OPT.Node);
  411.         VAR y: OPT.Node;
  412.     BEGIN
  413.         IF sym # rbrace THEN
  414.             Element(x);
  415.             LOOP
  416.                 IF sym = comma THEN OPS.Get(sym)
  417.                 ELSIF (lparen <= sym) & (sym <= ident) THEN err(comma)
  418.                 ELSE EXIT
  419.                 END ;
  420.                 Element(y); OPB.Op(plus, x, y)
  421.             END
  422.         ELSE x := OPB.EmptySet()
  423.         END ;
  424.         CheckSym(rbrace)
  425.     END Sets;
  426.     PROCEDURE Factor(VAR x: OPT.Node);
  427.         VAR fpar, id: OPT.Object; apar: OPT.Node;
  428.     BEGIN
  429.         IF sym < lparen THEN err(13);
  430.             REPEAT OPS.Get(sym) UNTIL sym >= lparen
  431.         END ;
  432.         IF sym = ident THEN
  433.             qualident(id); x := OPB.NewLeaf(id); selector(x);
  434.             IF (x^.class = Nproc) & (x^.obj^.mode = SProc) THEN StandProcCall(x)    (* x may be NIL *)
  435.             ELSIF sym = lparen THEN
  436.                 OPS.Get(sym); OPB.PrepCall(x, fpar);
  437.                 ActualParameters(apar, fpar);
  438.                 OPB.Call(x, apar, fpar);
  439.                 CheckSym(rparen);
  440.                 IF level > 0 THEN OPT.topScope^.link^.leaf := FALSE END
  441.             END
  442.         ELSIF sym = number THEN
  443.             CASE OPS.numtyp OF
  444.                char: x := OPB.NewIntConst(OPS.intval); x^.typ := OPT.chartyp
  445.             | integer: x := OPB.NewIntConst(OPS.intval)
  446.             | real: x := OPB.NewRealConst(OPS.realval, OPT.realtyp)
  447.             | longreal: x := OPB.NewRealConst(OPS.lrlval, OPT.lrltyp)
  448.             END ;
  449.             OPS.Get(sym)
  450.         ELSIF sym = string THEN
  451.             x := OPB.NewString(OPS.str, OPS.intval); OPS.Get(sym)
  452.         ELSIF sym = nil THEN
  453.             x := OPB.Nil(); OPS.Get(sym)
  454.         ELSIF sym = lparen THEN
  455.             OPS.Get(sym); Expression(x); CheckSym(rparen)
  456.         ELSIF sym = lbrak THEN
  457.             OPS.Get(sym); err(lparen); Expression(x); CheckSym(rparen)
  458.         ELSIF sym = lbrace THEN OPS.Get(sym); Sets(x)
  459.         ELSIF sym = not THEN
  460.             OPS.Get(sym); Factor(x); OPB.MOp(not, x)
  461.         ELSE err(13); OPS.Get(sym); x := NIL
  462.         END ;
  463.         IF x = NIL THEN x := OPB.NewIntConst(1); x^.typ := OPT.undftyp END
  464.     END Factor;
  465.     PROCEDURE Term(VAR x: OPT.Node);
  466.         VAR y: OPT.Node; mulop: SHORTINT;
  467.     BEGIN Factor(x);
  468.         WHILE (times <= sym) & (sym <= and) DO
  469.             mulop := sym; OPS.Get(sym);
  470.             Factor(y); OPB.Op(mulop, x, y)
  471.         END
  472.     END Term;
  473.     PROCEDURE SimpleExpression(VAR x: OPT.Node);
  474.         VAR y: OPT.Node; addop: SHORTINT;
  475.     BEGIN
  476.         IF sym = minus THEN OPS.Get(sym); Term(x); OPB.MOp(minus, x)
  477.         ELSIF sym = plus THEN OPS.Get(sym); Term(x); OPB.MOp(plus, x)
  478.         ELSE Term(x)
  479.         END ;
  480.         WHILE (plus <= sym) & (sym <= or) DO
  481.             addop := sym; OPS.Get(sym);
  482.             Term(y); OPB.Op(addop, x, y)
  483.         END
  484.     END SimpleExpression;
  485.     PROCEDURE Expression(VAR x: OPT.Node);
  486.         VAR y: OPT.Node; obj: OPT.Object; relation: SHORTINT;
  487.     BEGIN SimpleExpression(x);
  488.         IF (eql <= sym) & (sym <= geq) THEN
  489.             relation := sym; OPS.Get(sym);
  490.             SimpleExpression(y); OPB.Op(relation, x, y)
  491.         ELSIF sym = in THEN
  492.             OPS.Get(sym); SimpleExpression(y); OPB.In(x, y)
  493.         ELSIF sym = is THEN
  494.             OPS.Get(sym);
  495.             IF sym = ident THEN
  496.                 qualident(obj);
  497.                 IF obj^.mode = Typ THEN OPB.TypTest(x, obj, FALSE)
  498.                 ELSE err(52)
  499.                 END
  500.             ELSE err(ident)
  501.             END
  502.         END
  503.     END Expression;
  504.     PROCEDURE Receiver(VAR mode: SHORTINT; VAR name: OPS.Name; VAR typ, rec: OPT.Struct);
  505.         VAR obj: OPT.Object;
  506.     BEGIN typ := OPT.undftyp; rec := NIL;
  507.         IF sym = var THEN OPS.Get(sym); mode := VarPar ELSE mode := Var END ;
  508.         name := OPS.name; CheckSym(ident); CheckSym(colon);
  509.         IF sym = ident THEN OPT.Find(obj); OPS.Get(sym);
  510.             IF obj = NIL THEN err(0)
  511.             ELSIF obj^.mode # Typ THEN err(72)
  512.             ELSE typ := obj^.typ; rec := typ;
  513.                 IF rec^.form = Pointer THEN rec := rec^.BaseTyp END ;
  514.                 IF ~((mode = Var) & (typ^.form = Pointer) & (rec^.comp = Record) OR
  515.                     (mode = VarPar) & (typ^.comp = Record)) THEN err(70); rec := NIL END ;
  516.                 IF (rec # NIL) & (rec^.mno # level) THEN err(72); rec := NIL END
  517.             END
  518.         ELSE err(ident)
  519.         END ;
  520.         CheckSym(rparen);
  521.         IF rec = NIL THEN rec := OPT.NewStr(Comp, Record); rec^.BaseTyp := NIL END
  522.     END Receiver;
  523.     PROCEDURE Extends(x, b: OPT.Struct): BOOLEAN;
  524.     BEGIN
  525.         IF (b^.form = Pointer) & (x^.form = Pointer) THEN b := b^.BaseTyp; x := x^.BaseTyp END ;
  526.         IF (b^.comp = Record) & (x^.comp = Record) THEN
  527.             REPEAT x := x^.BaseTyp UNTIL (x = NIL) OR (x = b)
  528.         END ;
  529.         RETURN x = b
  530.     END Extends;
  531.     PROCEDURE ProcedureDeclaration(VAR x: OPT.Node);
  532.         VAR proc, fwd: OPT.Object;
  533.             name: OPS.Name;
  534.             mode, vis: SHORTINT;
  535.             forward: BOOLEAN;
  536.         PROCEDURE GetCode;
  537.             VAR ext: OPT.ConstExt; n: INTEGER; c: LONGINT;
  538.         BEGIN
  539.             ext := OPT.NewExt(); proc^.conval^.ext := ext; n := 0;
  540.             IF sym = string THEN
  541.                 WHILE OPS.str[n] # 0X DO ext[n+1] := OPS.str[n]; INC(n) END ;
  542.                 ext^[0] := CHR(n); OPS.Get(sym)
  543.             ELSE
  544.                 LOOP
  545.                     IF sym = number THEN c := OPS.intval; INC(n);
  546.                         IF (c < 0) OR (c > 255) OR (n = OPT.MaxConstLen) THEN
  547.                             err(64); c := 1; n := 1
  548.                         END ;
  549.                         OPS.Get(sym); ext^[n] := CHR(c)
  550.                     END ;
  551.                     IF sym = comma THEN OPS.Get(sym)
  552.                     ELSIF sym = number THEN err(comma)
  553.                     ELSE ext^[0] := CHR(n); EXIT
  554.                     END
  555.                 END
  556.             END ;
  557.             INCL(proc^.conval^.setval, hasBody)
  558.         END GetCode;
  559.         PROCEDURE GetParams;
  560.         BEGIN
  561.             proc^.vis := vis; proc^.mode := mode; proc^.typ := OPT.notyp;
  562.             proc^.conval := OPT.NewConst(); proc^.conval^.setval := {};
  563.             IF sym = lparen THEN
  564.                 OPS.Get(sym); FormalParameters(proc^.link, proc^.typ)
  565.             END ;
  566.             IF fwd # NIL THEN
  567.                 OPB.CheckParameters(proc^.link, fwd^.link, TRUE);
  568.                 IF proc^.typ # fwd^.typ THEN err(117) END ;
  569.                 proc := fwd; OPT.topScope := proc^.scope;
  570.                 IF mode = IProc THEN proc^.mode := IProc END
  571.             END
  572.         END GetParams;
  573.         PROCEDURE Body;
  574.             VAR procdec, statseq: OPT.Node; c: LONGINT;
  575.         BEGIN
  576.             c := OPM.errpos;
  577.             INCL(proc^.conval^.setval, hasBody);
  578.             CheckSym(semicolon); Block(procdec, statseq);
  579.             OPB.Enter(procdec, statseq, proc); x := procdec;
  580.             x^.conval := OPT.NewConst(); x^.conval^.intval := c;
  581.             IF sym = ident THEN
  582.                 IF OPS.name # proc^.name THEN err(4) END ;
  583.                 OPS.Get(sym)
  584.             ELSE err(ident)
  585.             END
  586.         END Body;
  587.         PROCEDURE TProcDecl;
  588.             VAR baseProc: OPT.Object;
  589.                 objTyp, recTyp: OPT.Struct;
  590.                 objMode: SHORTINT;
  591.                 objName: OPS.Name;
  592.         BEGIN
  593.             OPS.Get(sym); mode := TProc;
  594.             IF level > 0 THEN err(73) END ;
  595.             Receiver(objMode, objName, objTyp, recTyp);
  596.             IF sym = ident THEN
  597.                 name := OPS.name; CheckMark(vis);
  598.                 OPT.FindField(name, recTyp, fwd);
  599.                 OPT.FindField(name, recTyp^.BaseTyp, baseProc);
  600.                 IF (baseProc # NIL) & (baseProc^.mode # TProc) THEN baseProc := NIL END ;
  601.                 IF fwd = baseProc THEN fwd := NIL END ;
  602.                 IF (fwd # NIL) & (fwd^.mnolev # level) THEN fwd := NIL END ;
  603.                 IF (fwd # NIL) & (fwd^.mode = TProc) & ~(hasBody IN fwd^.conval^.setval) THEN
  604.                     (* there exists a corresponding forward declaration *)
  605.                     proc := OPT.NewObj(); proc^.leaf := TRUE;
  606.                     IF fwd^.vis # vis THEN err(118) END
  607.                 ELSE
  608.                     IF fwd # NIL THEN err(1); fwd := NIL END ;
  609.                     OPT.OpenScope(0, NIL); OPT.topScope^.right := recTyp^.link; OPT.Insert(name, proc);
  610.                     recTyp^.link := OPT.topScope^.right; OPT.CloseScope; 
  611.                 END ;
  612.                 INC(level); OPT.OpenScope(level, proc);
  613.                 OPT.Insert(objName, proc^.link); proc^.link^.mode := objMode; proc^.link^.typ := objTyp;
  614.                 GetParams;
  615.                 IF baseProc # NIL THEN
  616.                     IF (objMode # baseProc^.link^.mode) OR ~Extends(objTyp, baseProc^.link^.typ) THEN err(115) END ;
  617.                     OPB.CheckParameters(proc^.link^.link, baseProc^.link^.link, FALSE);
  618.                     IF proc^.typ # baseProc^.typ THEN err(117) END ;
  619.                     IF (baseProc^.vis = external) & (proc^.vis = internal) &
  620.                         (recTyp^.strobj # NIL) & (recTyp^.strobj^.vis = external) THEN err(109)
  621.                     END ;
  622.                     INCL(proc^.conval^.setval, isRedef)
  623.                 END ;
  624.                 IF ~forward THEN Body END ;
  625.                 DEC(level); OPT.CloseScope
  626.             ELSE err(ident)
  627.             END
  628.         END TProcDecl;
  629.     BEGIN proc := NIL; forward := FALSE; x := NIL; mode := LProc;
  630.         IF (sym # ident) & (sym # lparen) THEN
  631.             IF sym = times THEN    (* mode set later in OPB.CheckAssign *)
  632.             ELSIF sym = arrow THEN forward := TRUE
  633.             ELSIF sym = plus THEN mode := IProc
  634.             ELSIF sym = minus THEN mode := CProc
  635.             ELSE err(ident)
  636.             END ;
  637.             IF (mode IN {IProc, CProc}) & ~OPT.SYSimported THEN err(135) END ;
  638.             OPS.Get(sym)
  639.         END ;
  640.         IF sym = lparen THEN TProcDecl
  641.         ELSIF sym = ident THEN OPT.Find(fwd);
  642.             name := OPS.name; CheckMark(vis);
  643.             IF (vis # internal) & (mode = LProc) THEN mode := XProc END ;
  644.             IF (fwd # NIL) & ((fwd^.mnolev # level) OR (fwd^.mode = SProc)) THEN fwd := NIL END ;
  645.             IF (fwd # NIL) & (fwd^.mode IN {LProc, XProc}) & ~(hasBody IN fwd^.conval^.setval) THEN
  646.                 (* there exists a corresponding forward declaration *)
  647.                 proc := OPT.NewObj(); proc^.leaf := TRUE;
  648.                 IF fwd^.vis # vis THEN err(118) END
  649.             ELSE
  650.                 IF fwd # NIL THEN err(1); fwd := NIL END ;
  651.                 OPT.Insert(name, proc)
  652.             END ;
  653.             IF (mode # LProc) & (level > 0) THEN err(73) END ;
  654.             INC(level); OPT.OpenScope(level, proc);
  655.             proc^.link := NIL; GetParams;
  656.             IF mode = CProc THEN GetCode
  657.             ELSIF ~forward THEN Body
  658.             END ;
  659.             DEC(level); OPT.CloseScope
  660.         ELSE err(ident)
  661.         END
  662.     END ProcedureDeclaration;
  663.     PROCEDURE CaseLabelList(VAR lab: OPT.Node; LabelForm: INTEGER; VAR n: INTEGER; VAR tab: CaseTable);
  664.         VAR x, y, lastlab: OPT.Node; i, f: INTEGER; xval, yval: LONGINT;
  665.     BEGIN lab := NIL; lastlab := NIL;
  666.         LOOP ConstExpression(x); f := x^.typ^.form;
  667.             IF f IN intSet + {Char} THEN  xval := x^.conval^.intval
  668.             ELSE err(61); xval := 1
  669.             END ;
  670.             IF f IN intSet THEN
  671.                 IF LabelForm < f THEN err(60) END
  672.             ELSIF LabelForm # f THEN err(60)
  673.             END ;
  674.             IF sym = upto THEN
  675.                 OPS.Get(sym); ConstExpression(y); yval := y^.conval^.intval;
  676.                 IF (y^.typ^.form # f) & ~((f IN intSet) & (y^.typ^.form IN intSet)) THEN err(60) END ;
  677.                 IF yval < xval THEN err(63); yval := xval END
  678.             ELSE yval := xval
  679.             END ;
  680.             x^.conval^.intval2 := yval;
  681.             (*enter label range into ordered table*)  i := n;
  682.             IF i < OPM.MaxCases THEN
  683.                 LOOP
  684.                     IF i = 0 THEN EXIT END ;
  685.                     IF tab[i-1].low <= yval THEN
  686.                         IF tab[i-1].high >= xval THEN err(62) END ;
  687.                         EXIT
  688.                     END ;
  689.                     tab[i] := tab[i-1]; DEC(i)
  690.                 END ;
  691.                 tab[i].low := xval; tab[i].high := yval; INC(n)
  692.             ELSE err(213)
  693.             END ;
  694.             OPB.Link(lab, lastlab, x);
  695.             IF sym = comma THEN OPS.Get(sym)
  696.             ELSIF (sym = number) OR (sym = ident) THEN err(comma)
  697.             ELSE EXIT
  698.             END
  699.         END
  700.     END CaseLabelList;
  701.     PROCEDURE StatSeq(VAR stat: OPT.Node);
  702.         VAR fpar, id, t, obj: OPT.Object; idtyp: OPT.Struct; e: BOOLEAN;
  703.                 s, x, y, z, apar, last, lastif: OPT.Node; pos: LONGINT; name: OPS.Name;
  704.         PROCEDURE CasePart(VAR x: OPT.Node);
  705.             VAR n: INTEGER; low, high: LONGINT; e: BOOLEAN;
  706.                     tab: CaseTable; cases, lab, y, lastcase: OPT.Node; 
  707.         BEGIN
  708.             Expression(x); pos := OPM.errpos;
  709.             IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126)
  710.             ELSIF ~(x^.typ^.form IN {Char..LInt}) THEN err(125)
  711.             END ;
  712.             CheckSym(of); cases := NIL; lastcase := NIL; n := 0;
  713.             LOOP
  714.                 IF sym < bar THEN
  715.                     CaseLabelList(lab, x^.typ^.form, n, tab);
  716.                     CheckSym(colon); StatSeq(y);
  717.                     OPB.Construct(Ncasedo, lab, y); OPB.Link(cases, lastcase, lab)
  718.                 END ;
  719.                 IF sym = bar THEN OPS.Get(sym) ELSE EXIT END
  720.             END ;
  721.             IF n > 0 THEN low := tab[0].low; high := tab[n-1].high;
  722.                 IF high - low > OPM.MaxCaseRange THEN err(209) END
  723.             ELSE low := 1; high := 0
  724.             END ;
  725.             e := sym = else;
  726.             IF e THEN OPS.Get(sym); StatSeq(y) ELSE y := NIL END ;
  727.             OPB.Construct(Ncaselse, cases, y); OPB.Construct(Ncase, x, cases);
  728.             cases^.conval := OPT.NewConst();
  729.             cases^.conval^.intval := low; cases^.conval^.intval2 := high;
  730.             IF e THEN cases^.conval^.setval := {1} ELSE cases^.conval^.setval := {} END
  731.         END CasePart;
  732.         PROCEDURE SetPos(x: OPT.Node);
  733.         BEGIN
  734.             x^.conval := OPT.NewConst(); x^.conval^.intval := pos
  735.         END SetPos;
  736.         PROCEDURE CheckBool(VAR x: OPT.Node);
  737.         BEGIN
  738.             IF (x^.class = Ntype) OR (x^.class = Nproc) THEN err(126); x := OPB.NewBoolConst(FALSE)
  739.             ELSIF x^.typ^.form # Bool THEN err(120); x := OPB.NewBoolConst(FALSE)
  740.             END ;
  741.             pos := OPM.errpos
  742.         END CheckBool;
  743.     BEGIN stat := NIL; last := NIL;
  744.         LOOP x := NIL;
  745.             IF sym < ident THEN err(14);
  746.                 REPEAT OPS.Get(sym) UNTIL sym >= ident
  747.             END ;
  748.             IF sym = ident THEN
  749.                 qualident(id); x := OPB.NewLeaf(id); selector(x);
  750.                 IF sym = becomes THEN
  751.                     OPS.Get(sym); Expression(y); OPB.Assign(x, y)
  752.                 ELSIF sym = eql THEN
  753.                     err(becomes); OPS.Get(sym); Expression(y); OPB.Assign(x, y)
  754.                 ELSIF (x^.class = Nproc) & (x^.obj^.mode = SProc) THEN
  755.                     StandProcCall(x);
  756.                     IF (x # NIL) & (x^.typ # OPT.notyp) THEN err(55) END
  757.                 ELSE OPB.PrepCall(x, fpar);
  758.                     IF sym = lparen THEN
  759.                         OPS.Get(sym); ActualParameters(apar, fpar); CheckSym(rparen)
  760.                     ELSE apar := NIL;
  761.                         IF fpar # NIL THEN err(65) END
  762.                     END ;
  763.                     OPB.Call(x, apar, fpar);
  764.                     IF x^.typ # OPT.notyp THEN err(55) END ;
  765.                     IF level > 0 THEN OPT.topScope^.link^.leaf := FALSE END
  766.                 END ;
  767.                 pos := OPM.errpos
  768.             ELSIF sym = if THEN
  769.                 OPS.Get(sym); Expression(x); CheckBool(x); CheckSym(then); StatSeq(y);
  770.                 OPB.Construct(Nif, x, y); SetPos(x); lastif := x;
  771.                 WHILE sym = elsif DO
  772.                     OPS.Get(sym); Expression(y); CheckBool(y); CheckSym(then); StatSeq(z);
  773.                     OPB.Construct(Nif, y, z); SetPos(y); OPB.Link(x, lastif, y);
  774.                 END ;
  775.                 IF sym = else THEN OPS.Get(sym); StatSeq(y)
  776.                 ELSE y := NIL
  777.                 END ;
  778.                 OPB.Construct(Nifelse, x, y); CheckSym(end); OPB.OptIf(x); pos := OPM.errpos
  779.             ELSIF sym = case THEN
  780.                 OPS.Get(sym); CasePart(x); CheckSym(end)
  781.             ELSIF sym = while THEN
  782.                 OPS.Get(sym); Expression(x); CheckBool(x); CheckSym(do); StatSeq(y);
  783.                 OPB.Construct(Nwhile, x, y); CheckSym(end)
  784.             ELSIF sym = repeat THEN
  785.                 OPS.Get(sym); StatSeq(x);
  786.                 IF sym = until THEN OPS.Get(sym); Expression(y); CheckBool(y)
  787.                 ELSE err(until)
  788.                 END ;
  789.                 OPB.Construct(Nrepeat, x, y)
  790.             ELSIF sym = for THEN
  791.                 OPS.Get(sym);
  792.                 IF sym = ident THEN qualident(id);
  793.                     IF ~(id^.typ^.form IN intSet) THEN err(68) END ;
  794.                     CheckSym(becomes); Expression(y); pos := OPM.errpos;
  795.                     x := OPB.NewLeaf(id); OPB.Assign(x, y); SetPos(x);
  796.                     CheckSym(to); Expression(y); pos := OPM.errpos;
  797.                     IF y^.class # Nconst THEN
  798.                         name := "@@"; OPT.Insert(name, t); t^.name := "@for";
  799.                         t^.mode := Var; t^.typ := x^.left^.typ;
  800.                         obj := OPT.topScope^.scope;
  801.                         IF obj = NIL THEN OPT.topScope^.scope := t
  802.                         ELSE
  803.                             WHILE obj^.link # NIL DO obj := obj^.link END ;
  804.                             obj^.link := t
  805.                         END ;
  806.                         z := OPB.NewLeaf(t); OPB.Assign(z, y); SetPos(z); OPB.Link(stat, last, z);
  807.                         y := OPB.NewLeaf(t)
  808.                     ELSIF (y^.typ^.form < SInt) OR (y^.typ^.form > x^.left^.typ^.form) THEN err(113)
  809.                     END ;
  810.                     OPB.Link(stat, last, x);
  811.                     IF sym = by THEN OPS.Get(sym); ConstExpression(z) ELSE z := OPB.NewIntConst(1) END ;
  812.                     pos := OPM.errpos; x := OPB.NewLeaf(id);
  813.                     IF z^.conval^.intval > 0 THEN OPB.Op(leq, x, y)
  814.                     ELSIF z^.conval^.intval < 0 THEN OPB.Op(geq, x, y)
  815.                     ELSE err(63); OPB.Op(geq, x, y)
  816.                     END ;
  817.                     CheckSym(do); StatSeq(s);
  818.                     y := OPB.NewLeaf(id); OPB.StPar1(y, z, incfn); SetPos(y);
  819.                     IF s = NIL THEN s := y
  820.                     ELSE z := s;
  821.                         WHILE z^.link # NIL DO z := z^.link END ;
  822.                         z^.link := y
  823.                     END ;
  824.                     CheckSym(end); OPB.Construct(Nwhile, x, s)
  825.                 ELSE err(ident)
  826.                 END
  827.             ELSIF sym = loop THEN
  828.                 OPS.Get(sym); INC(LoopLevel); StatSeq(x); DEC(LoopLevel);
  829.                 OPB.Construct(Nloop, x, NIL); CheckSym(end); pos := OPM.errpos
  830.             ELSIF sym = with THEN
  831.                 OPS.Get(sym); idtyp := NIL; x := NIL;
  832.                 LOOP
  833.                     IF sym = ident THEN
  834.                         qualident(id); y := OPB.NewLeaf(id);
  835.                         IF (id # NIL) & (id^.typ^.form = Pointer) & ((id^.mode = VarPar) OR ~id^.leaf) THEN
  836.                             err(-302)    (* warning 302 *)
  837.                         END ;
  838.                         CheckSym(colon);
  839.                         IF sym = ident THEN qualident(t);
  840.                             IF t^.mode = Typ THEN
  841.                                 IF id # NIL THEN
  842.                                     idtyp := id^.typ; OPB.TypTest(y, t, FALSE); id^.typ := t^.typ
  843.                                 ELSE err(130)
  844.                                 END
  845.                             ELSE err(52)
  846.                             END
  847.                         ELSE err(ident)
  848.                         END
  849.                     ELSE err(ident)
  850.                     END ;
  851.                     pos := OPM.errpos; CheckSym(do); StatSeq(s); OPB.Construct(Nif, y, s); SetPos(y);
  852.                     IF idtyp # NIL THEN id^.typ := idtyp; idtyp := NIL END ;
  853.                     IF x = NIL THEN x := y; lastif := x ELSE OPB.Link(x, lastif, y) END ;
  854.                     IF sym = bar THEN OPS.Get(sym) ELSE EXIT END
  855.                 END;
  856.                 e := sym = else;
  857.                 IF e THEN OPS.Get(sym); StatSeq(s) ELSE s := NIL END ;
  858.                 OPB.Construct(Nwith, x, s); CheckSym(end);
  859.                 IF e THEN x^.subcl := 1 END
  860.             ELSIF sym = exit THEN
  861.                 OPS.Get(sym);
  862.                 IF LoopLevel = 0 THEN err(46) END ;
  863.                 OPB.Construct(Nexit, x, NIL);
  864.                 pos := OPM.errpos
  865.             ELSIF sym = return THEN OPS.Get(sym);
  866.                 IF sym < semicolon THEN Expression(x) END ;
  867.                 IF level > 0 THEN OPB.Return(x, OPT.topScope^.link)
  868.                 ELSE (* not standard Oberon *) OPB.Return(x, NIL)
  869.                 END ;
  870.                 pos := OPM.errpos
  871.             END ;
  872.             IF x # NIL THEN SetPos(x); OPB.Link(stat, last, x) END ;
  873.             IF sym = semicolon THEN OPS.Get(sym)
  874.             ELSIF (sym <= ident) OR (if <= sym) & (sym <= return) THEN err(semicolon)
  875.             ELSE EXIT
  876.             END
  877.         END
  878.     END StatSeq;
  879.     PROCEDURE Block(VAR procdec, statseq: OPT.Node);
  880.         VAR typ: OPT.Struct;
  881.             obj, first, last: OPT.Object;
  882.             x, lastdec: OPT.Node;
  883.             i: INTEGER;
  884.     BEGIN first := NIL; last := NIL; nofFwdPtr := 0;
  885.         LOOP
  886.             IF sym = const THEN
  887.                 OPS.Get(sym);
  888.                 WHILE sym = ident DO
  889.                     OPT.Insert(OPS.name, obj); CheckMark(obj^.vis);
  890.                     obj^.typ := OPT.sinttyp; obj^.mode := Var;    (* Var to avoid recursive definition *)
  891.                     IF sym = eql THEN
  892.                         OPS.Get(sym); ConstExpression(x)
  893.                     ELSIF sym = becomes THEN
  894.                         err(eql); OPS.Get(sym); ConstExpression(x)
  895.                     ELSE err(eql); x := OPB.NewIntConst(1)
  896.                     END ;
  897.                     obj^.mode := Con; obj^.typ := x^.typ; obj^.conval := x^.conval; (* ConstDesc ist not copied *)
  898.                     CheckSym(semicolon)
  899.                 END
  900.             END ;
  901.             IF sym = type THEN
  902.                 OPS.Get(sym);
  903.                 WHILE sym = ident DO
  904.                     OPT.Insert(OPS.name, obj); obj^.mode := Typ; obj^.typ := OPT.undftyp;
  905.                     CheckMark(obj^.vis);
  906.                     IF sym = eql THEN
  907.                         OPS.Get(sym); TypeDecl(obj^.typ, obj^.typ)
  908.                     ELSIF (sym = becomes) OR (sym = colon) THEN
  909.                         err(eql); OPS.Get(sym); TypeDecl(obj^.typ, obj^.typ)
  910.                     ELSE err(eql)
  911.                     END ;
  912.                     IF obj^.typ^.strobj = NIL THEN obj^.typ^.strobj := obj END ;
  913.                     IF obj^.typ^.comp IN {Record, Array, DynArr} THEN
  914.                         i := 0;
  915.                         WHILE i < nofFwdPtr DO typ := FwdPtr[i]; INC(i);
  916.                             IF typ^.link^.name = obj^.name THEN typ^.BaseTyp := obj^.typ; typ^.link^.name := "" END
  917.                         END
  918.                     END ;
  919.                     CheckSym(semicolon)
  920.                 END
  921.             END ;
  922.             IF sym = var THEN
  923.                 OPS.Get(sym);
  924.                 WHILE sym = ident DO
  925.                     LOOP
  926.                         IF sym = ident THEN
  927.                             OPT.Insert(OPS.name, obj); CheckMark(obj^.vis);
  928.                             obj^.mode := Var; obj^.link := NIL; obj^.leaf := obj^.vis = internal; obj^.typ := OPT.undftyp;
  929.                             IF first = NIL THEN first := obj END ;
  930.                             IF last = NIL THEN OPT.topScope^.scope := obj ELSE last^.link := obj END ;
  931.                             last := obj
  932.                         ELSE err(ident)
  933.                         END ;
  934.                         IF sym = comma THEN OPS.Get(sym)
  935.                         ELSIF sym = ident THEN err(comma)
  936.                         ELSE EXIT
  937.                         END
  938.                     END ;
  939.                     CheckSym(colon); Type(typ, OPT.notyp);
  940.                     IF typ^.comp = DynArr THEN typ := OPT.undftyp; err(88) END ;
  941.                     WHILE first # NIL DO first^.typ := typ; first := first^.link END ;
  942.                     CheckSym(semicolon)
  943.                 END
  944.             END ;
  945.             IF (sym < const) OR (sym > var) THEN EXIT END ;
  946.         END ;
  947.         i := 0;
  948.         WHILE i < nofFwdPtr DO
  949.             IF FwdPtr[i]^.link^.name # "" THEN err(128) END ;
  950.             FwdPtr[i] := NIL;    (* garbage collection *)
  951.             INC(i)
  952.         END ;
  953.         OPT.topScope^.adr := OPM.errpos;
  954.         procdec := NIL; lastdec := NIL;
  955.         WHILE sym = procedure DO
  956.             OPS.Get(sym); ProcedureDeclaration(x);
  957.             IF x # NIL THEN
  958.                 IF lastdec = NIL THEN procdec := x ELSE lastdec^.link := x END ;
  959.                 lastdec := x
  960.             END ;
  961.             CheckSym(semicolon)
  962.         END ;
  963.         IF sym = begin THEN OPS.Get(sym); StatSeq(statseq)
  964.         ELSE statseq := NIL
  965.         END ;
  966.         IF (level = 0) & (TDinit # NIL) THEN
  967.             lastTDinit^.link := statseq; statseq := TDinit
  968.         END ;
  969.         CheckSym(end)
  970.     END Block;
  971.     PROCEDURE Module*(VAR prog: OPT.Node; VAR modName: OPS.Name);
  972.         VAR impName, aliasName: OPS.Name;
  973.                 procdec, statseq: OPT.Node;
  974.                 c: LONGINT;
  975.     BEGIN
  976.         LoopLevel := 0; level := 0;
  977.         OPS.Get(sym);
  978.         IF sym = module THEN OPS.Get(sym) ELSE err(16) END ;
  979.         IF sym = ident THEN
  980.             COPY(OPS.name, modName); OPS.Get(sym); CheckSym(semicolon);
  981.             IF sym = import THEN OPS.Get(sym);
  982.                 LOOP
  983.                     IF sym = ident THEN
  984.                         COPY(OPS.name, aliasName); COPY(aliasName, impName); OPS.Get(sym);
  985.                         IF sym = becomes THEN OPS.Get(sym);
  986.                             IF sym = ident THEN COPY(OPS.name, impName); OPS.Get(sym) ELSE err(ident) END
  987.                         END ;
  988.                         OPT.Import(aliasName, impName, modName)
  989.                     ELSE err(ident)
  990.                     END ;
  991.                     IF sym = comma THEN OPS.Get(sym)
  992.                     ELSIF sym = ident THEN err(comma)
  993.                     ELSE EXIT
  994.                     END
  995.                 END ;
  996.                 CheckSym(semicolon)
  997.             END ;
  998.             IF OPM.noerr THEN TDinit := NIL; lastTDinit := NIL; c := OPM.errpos;
  999.                 Block(procdec, statseq); OPB.Enter(procdec, statseq, NIL); prog := procdec;
  1000.                 prog^.conval := OPT.NewConst(); prog^.conval^.intval := c;
  1001.                 IF sym = ident THEN
  1002.                     IF OPS.name # modName THEN err(4) END ;
  1003.                     OPS.Get(sym)
  1004.                 ELSE err(ident)
  1005.                 END ;
  1006.                 IF sym # period THEN err(period) END
  1007.             END
  1008.         ELSE err(ident)
  1009.         END ;
  1010.         TDinit := NIL; lastTDinit := NIL
  1011.     END Module;
  1012. END OPP.
  1013.